home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / AGGR.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  58KB  |  1,821 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* aggr.c : translation of aggr.stl */
  10.  
  11. #define GEN
  12. #include "hdr.h"
  13. #include "vars.h"
  14. #include "gvars.h"
  15. #include "attr.h"
  16. #include "miscp.h"
  17. #include "setp.h"
  18. #include "gutilp.h"
  19. #include "gnodesp.h"
  20. #include "gmiscp.h"
  21. #include "smiscp.h"
  22. #include "initobjp.h"
  23. #include "expandp.h"
  24. #include "aggrp.h"
  25.  
  26. static int tup_eq(Tuple, Tuple);
  27. static Tuple aggr_choice(Node, Tuple, Symbol);
  28. static int needs_subtype(Node, Node, Symbol);
  29. static Node new_type_choice(Node, Symbol, Tuple);
  30. static Tuple aggr_type(Node, Tuple);
  31. static Tuple same_bounds_check(Symbol, Tuple, Tuple);
  32. static Tuple in_bounds_check(Tuple, Tuple, int *);
  33. static Tuple aggr_eval(Node, Tuple, Tuple, Node, Symbol, int);
  34. static Node new_index_bound_node(Const, int, Symbol);
  35.  
  36. /* changes
  37.  * 13-mar-85    shields
  38.  * change 'index_type' to 'indx_type' since index_type is macro in sem.
  39.  *
  40.  * 18-6-86    ACD
  41.  * changed final loop over checks in 'same_bounds_check' to improve
  42.  * efficiency
  43.  *
  44.  * 19-6-86     ACD
  45.  * changed 'exists' to 'static_index' in 'aggr_eval' to improve clarity
  46.  *
  47.  * 22-6-86     ACD
  48.  * changed aggr_eval to allow for optimization of static and semi-static
  49.  * aggregates.  If the aggregate is static and associations and components
  50.  * are static then the aggregate is 'optable'.  A data segment will
  51.  * be created with the aggregate values in the data stack and will be
  52.  * assigned to the array at run time.  The creation of the stack is done
  53.  * by array_ivalue in expr.c.  aggr_eval unwinds the aggregate and changes
  54.  * it into a positional aggregate passing the correct information to 
  55.  * array_ivalue.  Array_ivalue uses the static_nodes to create the segment
  56.  * and appends additional assignment statements for any non-static components
  57.  * If there is an others clause,
  58.  * then it is used to 'fill-in' the missing associations.
  59.  *
  60.  * 24-6-86     ACD
  61.  * Added code to detect the following flags: static_assoc, array_size,
  62.  * static_component to be used in deciding whether to optimize or not.
  63.  * These are set in aggr_choice, in_bounds_check and check_static_comp
  64.  * (new routine) respectively.  From this information the flag:
  65.  * optable are set.  Ths is passed to aggr_eval
  66.  * to decide the level to optimize in attempt to evalaute a time-space
  67.  */
  68.  
  69. void expand_array_aggregate(Node node)            /*;expand_array_aggregate*/
  70. {
  71.     /*
  72.      *
  73.      *  This procedure normalizes the format of an array aggregate, and
  74.      *  constructs the tree for the multiple range checks that may have
  75.      *  to be performed before constructing the aggregate proper.
  76.      *  The aggregate has the format : [positional_list, named_list, others]
  77.      *
  78.      *  On exit from this procedure, the named_list has been expanded into
  79.      *  code to perform range checks, and code to initialize the array
  80.      *  components. The rules of the language require that this code be in
  81.      *  fact elaborated first, that is to say before the elaboration of any
  82.      *  components (including the positional ones).
  83.      *  The positional part has been expanded to collect static components
  84.      *  and give explicit indication of the index positions.
  85.      *  The following takes place in sequence:
  86.      *
  87.      *    a) expand code to evaluate named choices.
  88.      *    b) obtain all index types.
  89.      *    c) For multidimensional aggregates, verify that bounds of all
  90.      *       subaggregates are the same.
  91.      *    d) Verify that the aggregate bounds are compatible with type of
  92.      *       indices.
  93.      *    e) expand code to evaluate components. For named associations
  94.      *       that are static, it is tempting to elaborate the array here,
  95.      *       in full. This is probably impractical for large arrays. The
  96.      *       current solution is to emit a case statement that assigns to
  97.      *       individual components according to the choices.
  98.      *       In the case of a single named component, a loop is emitted.
  99.      *       The same holds for 'others' choice when present.
  100.      *       This scheme clearly contains much room for optimization.
  101.      *
  102.      */
  103.  
  104.     Symbol    type_name;
  105.     Tuple    index_type_list, base_index_type_list, tup, decl_code, ntup;
  106.     Symbol    comp_type, bt, al, obj_name;
  107.     Tuple    new_subtypes;
  108.     Tuple    index_type_sets;
  109.     Tuple    init_code, new_pos, new_index_type_list, new_nam;
  110.     Node    obj_node, pos_node, nam_node, comp_node, n, lnode;
  111.     Fortup    ft1;
  112.  
  113.     int      optable;
  114.     int      array_size;
  115.  
  116. #ifdef TRACE    
  117.     if (debug_flag)
  118.         gen_trace_node("ARRAY_AGGREGATE", node);
  119. #endif
  120.  
  121.  
  122.     /*
  123.      *  STEP 1
  124.      *     Initialize variables etc.
  125.      */
  126.  
  127.     type_name        = N_TYPE(node);
  128.     index_type_list = index_types(type_name);
  129.     tup = SIGNATURE((Symbol) base_type(type_name));
  130.     base_index_type_list = (Tuple) tup[1];
  131.     comp_type = (Symbol)tup[2];
  132.  
  133.     /*
  134.      * STEP 2
  135.      *    Evaluate all choices first, including choices in subaggregates 
  136.      *    declaring anon subtypes when necessary.  A tuple containing 
  137.      *    these declarations is returned.     
  138.      */
  139.     decl_code = aggr_choice(node, index_type_list, comp_type);
  140.  
  141.     /*
  142.      * STEP 3
  143.      *    Then gather all index subtypes for all dimensions.  Add the
  144.      *    code for the new subtypes created to tuple of declarations
  145.      */
  146.     tup = aggr_type(node, index_type_list);
  147.  
  148.     new_subtypes = (Tuple) tup[1];
  149.     index_type_sets = (Tuple) tup[2];
  150.  
  151.     tup_free(tup); ntup = tup_add(decl_code, new_subtypes);
  152.     tup_free(decl_code); decl_code = ntup; 
  153.     tup_free(new_subtypes); /* free after last use */
  154.  
  155.     /* 
  156.      * STEP 4
  157.      *    Now check that all bounds for each dimension are the same.  If bounds
  158.      *    are dynamic, then a set of run-time checks are returned
  159.      */
  160.     tup = same_bounds_check(type_name, index_type_list, index_type_sets);
  161.     init_code = (Tuple) tup[1];
  162.     new_index_type_list = (Tuple) tup[2];
  163.  
  164.     /*
  165.      * STEP 5
  166.      *   Is unconstrained or indices computed in same_bounds_check differ from
  167.      *   those computed in  aggr_type, then set the type of the aggregate to
  168.      *   the index_types to created in same_bounds_check
  169.      */
  170.     if (!tup_eq(index_type_list , new_index_type_list)
  171.       || is_unconstrained(type_name))  {
  172.         bt = base_type(type_name);
  173.         al = ALIAS(type_name);
  174.         type_name = new_unique_name("type");
  175.         NATURE(type_name) = na_subtype;
  176.         TYPE_OF(type_name) = bt;
  177.         tup = tup_new(2);
  178.         tup[1] = (char *) new_index_type_list;
  179.         tup[2] = (char *) comp_type;
  180.         SIGNATURE(type_name) = tup;
  181.         ALIAS(type_name) = al;
  182.         decl_code=tup_with(decl_code, (char *)new_subtype_decl_node(type_name));
  183.         index_type_list       = new_index_type_list;
  184.         N_TYPE(node)       = type_name;
  185.     }
  186.  
  187.     /*
  188.      * STEP 6
  189.      *    Now test that the index_types computed belong to the base_index_types.
  190.      *    If bounds are dynamic, then run_time checks are performed
  191.      */
  192.     array_size = 1;
  193.     tup = in_bounds_check(index_type_list, base_index_type_list, &array_size);
  194.     ntup = tup_add(init_code, tup);
  195.     tup_free(init_code);
  196.     init_code  = ntup;
  197.     tup_free(tup);
  198.  
  199.     /*
  200.      * STEP 7
  201.      *   Finally, expand assignments to individual components. 
  202.      *   Add to aggregate node the name of the object assigned to it. The 
  203.      *   variable, constant, or temporary to which the aggregate is 
  204.      *   assigned, will be bound to this name subsequently. This name has 
  205.      *   been put in the N_UNQ of the node by the FE. In the case of an 
  206.      *   aggregate appearing as the initial value of an object declaration, 
  207.      *   the name has been changed to the first name of the identifier list.
  208.      */
  209.     obj_name   = N_UNQ(node);
  210.     obj_node   = new_name_node(obj_name);
  211.     if (NATURE(obj_name) == na_void) {
  212.         new_symbol(obj_name, na_obj, N_TYPE(node), (Tuple)0, (Symbol)0);
  213.         /* else another copy of the aggregate was already expanded.
  214.          * this is the case if the aggregate is a default expression used
  215.          * in several calls.
  216.          */
  217.     }
  218.  
  219.     optable = (array_size > 0 && array_size < MAX_STATIC_SIZE
  220.       && !(is_unconstrained(comp_type)));
  221.  
  222.     ntup = tup_add(init_code, aggr_eval(node, new_index_type_list, tup_new(0),
  223.       obj_node, comp_type, optable));
  224.     tup_free(init_code);
  225.     init_code = ntup;
  226.  
  227.     /*
  228.      * STEP 8
  229.      *   Sort the nodes that initialize components into those that are pure- 
  230.      *   ly static and those that require emission of assignment statements.
  231.      */
  232.     new_pos = tup_new(0);
  233.     new_nam = tup_new(0);
  234.     FORTUP(